home *** CD-ROM | disk | FTP | other *** search
Text File | 1995-02-24 | 71.5 KB | 2,794 lines |
-
- // ───────────────────────────────────────────────────────────────────
- // The Aurora Editor v2.0
- // Copyright 1993-1995 nuText Systems. All Rights Reserved Worldwide.
- //
- // Editor library extensions (included by MAIN.AML)
- //
- // *You should be very familiar with AML before making changes here*
- // If you have made any changes, save this file and select 'Recompile
- // the Editor' <alt f2> from the Set menu. Exit and re-enter the
- // editor for your changes to take effect.
- // ───────────────────────────────────────────────────────────────────
-
- // ───────────────────────────────────────────────────────────────────
- // All windows
- // ───────────────────────────────────────────────────────────────────
-
- object a
-
- // get the drive and path portion of a filespec
- function getpath (file)
- return file [1 : pos "\\" file 'r']
- end
-
- // get the name and extension portion of a filespec
- function getname (file)
- return file [(pos "\\" file 'r') + 1 : 0]
- end
-
- // get the extension portion of a filespec
- function getext (file)
- p = pos '.' file 'r'
- if? p file [p : TO_END] ''
- end
-
- // append a default extension for filenames that don't have one
- function defext (file extension)
- if pos '.' file then
- file
- else
- file + '.' + extension
- end
- end
-
- // force a filename to have an extension
- function forceext (file ext)
- p = pos '.' file 'r'
- return (if? p file [1 : p] file + '.') + ext
- end
-
- // generate <shiftdown>, <shiftup> events from raw <shiftkey> event
- function <shiftkey> (newstate oldstate)
- send ( if newstate & 3 and not (oldstate & 3) then
- "shiftdown"
- elseif oldstate & 3 and not (newstate & 3) then
- "shiftup"
- end )
- end
-
- // generate multi-key events
- function prefix (keycode)
- keyname = locase (getkeyname keycode)
- say keyname + "<more...>"
- keyname2 = locase (getkeyname (getkey))
- queue keyname + keyname2
- // allow the <ctrl> key to be held down...
- if keyname [1:5] == "<ctrl" and keyname2 [1:5] == "<ctrl" then
- queue keyname + '<' + keyname2 [7 : TO_END]
- end
- display
- end
-
- // repeat keys for a user-specified number of times
- function askrepkey
- var keystring
- var i
- say "Enter keys to repeat, then <esc>:"
- hidecursor
- keycode = getkey
- while keycode <> <esc> do
- keystring = keystring + (char2 keycode)
- keycode = getkey
- end
- if keystring then
- count = ask "Number of repetitions"
- if count then
- strlen = sizeof keystring
- while count do
- j = 1
- while j < strlen do
- queuekey (bin2int keystring [j : 2])
- j = j + 2
- end
- repeat
- dispatch
- until not event?
- count = count - 1
- end
- end
- end
- end
-
- // a simple file picklist
- function picklist (filespec title)
- filespec = qualify filespec (getbufname)
- repeat
- filespec = askfile filespec filespec + title _FmgrSort _FmgrOpt
- until not (filespec and (dir? filespec))
- return filespec
- end
-
- // execute a fully qualified DOS program
- // (saving and restoring the current path)
- function os (program options)
- cp = getcurrpath
- currpath (getpath (getbufname))
- r = exec program options
- currpath cp
- return r
- end
-
- // shell to DOS by executing COMMAND.COM
- function shell
- os (getenv "COMSPEC") "ch"
- end
-
- // execute DOS commands, programs, and .bat files
- function run (file options)
- if file then
- os (getenv "COMSPEC") + " /c " + file options
- else
- shell
- end
- end
-
- // execute DOS commands or programs and capture the output
- // via DOS piping (will not capture .bat file output)
- function runcap (command options)
- _cap = _cap + 1
- capfile = qualify "capture." + _cap (getbufname)
- run command + '>' + capfile options
- open capfile
- deletefile capfile
- end
-
- // translate an AML compiler error code to an error message
- function errormsg (error)
- case error
- when 1001 "Can't open file"
- when 1002, 1003 "Read error"
- when 1004 "Not an executable macro file"
- when 1031 "Write error"
- when 1032 "Can't open compiler output file"
- when 1101 "No closing quote"
- when 1102 "No closing bracket"
- when 1103 "Invalid symbol"
- when 1104 "Invalid key or event"
- when 1301 "No terminator"
- when 1302 "Unexpected end of source"
- when 1303 "No closing parenthesis"
- when 1310 "Unexpected argument"
- when 1311 "Unexpected terminator"
- when 1312 "Unexpected function"
- when 1313 "Unexpected operator"
- when 1319 "Identifier '" + (geterror 's') + "' not defined"
- when 1320 "Bad assignment"
- when 1330 "Bad when clause"
- when 1336 "Improperly placed break"
- when 1337 "Invalid reference"
- when 1501 "Can't open include file " + (geterror 's')
- when 1502 "Include level exceeded"
- when 1503 "Can't include compiled file in expression"
- when 1504 "Include must be at top level"
- when 1505 "Define can't be nested"
- when 1506 "Function must be at top level"
- when 1507 "Can't redefine builtin function"
- when 1508 "Duplicated function argument"
- when 1509 "Object statement not permitted"
- when 1701 "Too many variables"
- when 1702 "Too many function arguments"
- when 1703 "Function or expression too large"
- when 1704, 1705, 1707 "Internal stack overflow"
- when 1706 "Out of symbol space"
- otherwise "Fatal compilation error " + error
- end
- end
-
- // compile a macro with error messages
- // the cursor is moved to any syntax errors
- function compilemacro2 (source dest msg)
- if not source then
- source = getbufname
- end
- say (if? msg msg "Compiling...")
- source = qualify (defext source "aml") (getbufname)
- error = compilemacro source (if? dest dest (forceext source 'x'))
-
- if error then
-
- // get additional error info
- column = geterror 'k'
- line = geterror 'l'
- file = geterror 'f'
-
- // translate error code to an error message
- msg = errormsg error
-
- // position the cursor to the error
- if error <> 1001 and (open file) then
- gotopos column line
- send "onfound"
- end
-
- // display the error
- msgbox file + " (line " + line + ", col " + column + "): " + msg
- "Error!" 'b'
- else
- say "Done."
- end
-
- return error
- end
-
- // regenerate the editor boot macro (a.x)
- function regen (msg)
- dest = bootpath "main.x"
- error = compilemacro2 (bootpath "main.aml") dest msg
- if not error then
- bootfile = bootpath "a.x"
- deletefile bootfile
- renamefile dest bootfile
- end
- return error
- end
-
- // regenerate the editor boot macro (a.x) with a message
- function recompile
- if not regen then
- msgbox "Exit and re-enter for changes to take effect. "
- end
- end
-
- // regenerate the editor boot macro (a.x) with a message,
- // and integrate current config variables in compilation
- function saveconfig
- configx = bootpath "config.x"
- saveobject "prf" configx
- regen "Saving..."
- deletefile configx
- end
-
- // load and run a compiled macro file
- function includemacro2 (macrofile)
- includemacro (qualify (forceext
- (if? macrofile macrofile (getbufname)) 'x') (getbufname))
- end
-
- // load, run, and discard a compiled macro file
- function runmacro2 (macrofile)
- runmacro (qualify (forceext
- (if? macrofile macrofile (getbufname)) 'x') (getbufname))
- end
-
- // send a string to the default printer device
- function printstr (string)
- if string then
- fileid = openfile _PrtDev 'w'
- if fileid then
- writefile fileid string
- closefile fileid
- end
- end
- end
-
- // open a new file
- function opennew (file options)
- prevbufname = getbufname
- buffer = createbuf
- if buffer then
- setbufname (qualify (if? file file "NEW.TXT") prevbufname)
- openbuf buffer options
- end
- end
-
- // toggle the video mode between 80x25 and 80x50
- function togglemode
- videomode 80 (if? getvidrows == 25 50 25)
- end
-
-
- // search/replace with verification
- // (returns the number of replacements made)
- function replver (searchstr replstr options)
-
- var title
- var count
-
- repeat
- length = find searchstr options
- if length then
-
- if not title then
- title = gettitle
- settitle "Replace (Yes/No/All/One/Reverse/Undo/Quit)? "
- // remove global for next find
- options = sub 'g' '' options
- end
-
- send "onfound" length
-
- // get keycode and convert to lower case
- p = getkey | 020h
- case p
-
- when <y>, <o>, <a>
- undobegin
- l = (replace searchstr replstr (sub 'r' '' options) + "*z") - 1
- if not (pos 'r' options) then
- right l
- end
- count = count + 1
- if p <> <y> then
- length = ''
- if p == <a> then
- count = count + (replace searchstr replstr options + "az")
- end
- end
- undoend
-
- when <u>
- if count then
- undo
- count = count - 1
- if pos 'r' options then
- right 1
- else
- if getcol == 1 then
- if up then
- col 16000
- end
- else
- left l
- end
- end
- end
-
- when <n>
- // do nothing
-
- when <r>
- options = if? (pos 'r' options) (sub 'r' '' options) options + 'r'
-
- otherwise
- if not count then
- count = '0'
- end
- break
- end
- end
- until not length
-
- if title then
- settitle title
- end
-
- return count
- end
-
-
- // search for a multi-string search argument
- function search (searchstr reverse rep refopt refrepl)
-
- var replstr
- var options
-
- // split up search multi-string
- if pos '/' searchstr then
- n = splitstr '' searchstr ref searchstr ref replstr ref options
- if n > 1 then
- if n == 2 then
- options = replstr
- replstr = ''
- // case sensitive
- if not options then
- options = 'c'
- end
- end
- end
- end
-
- if searchstr then
-
- // default options
- if not options then
- options = _SearchOpt
- if n > 2 then
- options = options + _ReplaceOpt
- end
- end
-
- // reverse search direction if specified
- if reverse then
- options = if pos 'r' options then
- sub 'r' '' options
- else
- options + 'r'
- end
- end
-
- // remove global for repeat find
- if rep and (pos 'g' options) then
- options = sub 'g' '' options
- end
-
- // return values for calling function to check
- refopt = options
- refrepl = n >= 3
-
- // resurface marked window for block search
- if pos 'b' options then
- buffer = getmarkbuf
- if buffer and buffer <> getcurrbuf then
- currwin (getcurswin (getcurrcurs buffer))
- end
- end
-
- // search and replace
- if n >= 3 then
-
- // do the replace
- if pos 'a' options then
- replace searchstr replstr options
- else
- replver searchstr replstr options
- end
-
- // search only
- else
- find searchstr options
- end
- end
- end
-
- // hot key for the file mgr and file picklists
- function onhotkey (character)
- searchstr = '^[~ ]' + (upcase character)
- if find searchstr 'x' then
- adjustrow getviewrows / 3
- return
- else
- line = getrow
- gotopos 1 1
- if find searchstr 'x*' then
- adjustrow getviewrows / 3
- return
- end
- // not found
- beep 320 70
- row line
- end
- end
-
-
- object mon
-
- // erase key macros
- function erasekey2 (options)
- if erasekey options then
- _kd = TRUE
- display
- say (if? (pos options 'a') "All keys macros erased"
- "Scrap key macro erased")
- end
- end
-
- // toggle the key macro record mode
- function record
- if not playing? then
- _kd = TRUE
- if not setting? 'R' then
- erasekey
- record_on = TRUE
- end
- setting 'R' TOGGLE
- say "Record" + (if? record_on "ing..." " OFF")
- end
- end
-
- // play a key macro
- function play (keymacro)
- setdisplay OFF
- if not (playkey keymacro) then
- say "No key macro to play." 'b'
- end
- setdisplay ON
- end
-
-
- // ───────────────────────────────────────────────────────────────────
- // Edit windows and File Manager windows
- // ───────────────────────────────────────────────────────────────────
-
- object edit_fmgr
-
- // close all windows
- function closeall (options)
- setxobj "__G" ON 'a'
- begdesk
- while getwincount and (send "close" options) end
- enddesk
- setxobj "__G" OFF 'a'
- end
-
- // move the cursor to any edge of a mark
- function gotomark (options)
- if mark? then
-
- window = getcurswin (getcurrcurs (getmarkbuf))
- if window then
- currwin window
- end
-
- // left or right
- if pos 'l' options then
- col (getmarkleft)
- elseif pos 'r' options then
- col (getmarkright)
- end
-
- // top or bottom
- if pos 't' options then
- row (getmarktop)
- elseif pos 'b' options then
- row (getmarkbot)
- end
-
- if window then
- send "onfound"
- end
-
- else
- say "Block not found" 'b'
- end
- end
-
- // goto a bookmark with message
- function gotobook2 (bookmark)
- msg = "Bookmark '" + bookmark + "'"
- if gotobook bookmark then
- window = getcurswin (getcurrcurs (getbookbuf bookmark))
- if window <> getcurrwin then
- currwin window
- end
- display
- say msg
- else
- say msg + " not found" 'b'
- end
- end
-
- // prompt to goto a bookmark
- function askbook (msg)
- askx (if? msg msg "Bookmark Name") "_book" "gotobook2"
- end
-
- // cycle though all existing bookmarks
- function cyclebook
- repeat
- l = _lb
- bookmark = if? l (getprevbook l) (getcurrbook)
- buffer = getcurrbuf
- while not bookmark and buffer do
- buffer = getprevbuf buffer
- bookmark = getcurrbook buffer
- end
- _lb = bookmark
- until bookmark or not l
- gotobook2 bookmark
- end
-
- // print the current buffer or mark
- function print (options)
- printstr _PrtIni
- header = _PrtHdr
- if not (posnot ' ' header) or (dir? (getbufname)) then
- date = getdate
- header = getbufname + " (" + date [posnot ' ' date : TO_END] +
- ' ' + gettime + ')'
- end
- if not ( if pos 'b' options then printblock _PrtDev header ''
- else printbuf _PrtDev header end ) then
- say "Print failed" 'b'
- end
- end
-
- // replace/append/cancel or ok/cancel menus
- function askrac (file menuname)
- if _ConRpl == 'y' and (locatefile file) then
- locase (popup (if? menuname menuname "rac" )
- file + " Exists" +
- (if? menuname == "ok" ". Replace?")) [1]
- else
- 'r'
- end
- end
-
- // generic prompt to change a configuration variable
- function askc (pstring variable history)
- newvalue = ask pstring history (lookup variable "prf")
- if newvalue then
- setxobj variable newvalue "prf"
- end
- end
-
- // prompts to change specific configuration variables
- function askbinary askc "Binary Line Length" "BinaryLength" end
- function askdelim askc "Line Delimiter String in Hex" "LineDlm" end
- function asktabw askc "Tab Width" "TabWidth" end
- function asktabv askc "Variable Tabs" "VarTabs" end
- function asklmarg askc "Left Margin" "LMargin" end
- function askrmarg askc "Right Margin" "RMargin" end
- function askclip askc "Clipboard Name" "ClipName" end
- function askprthdr askc "Current Header/Footer" "PrtHdr" end
-
- // generic prompt with command execution
- function askx (pstring history func parm2)
- parm1 = ask pstring history
- if parm1 then
- send func parm1 parm2
- if history then
- addhistory history parm1
- end
- return 1
- end
- end
-
- // open prompt
- function askopen
- file = ask "[file/ibcenz] Open" "_load"
- if file then
- // addhistory not needed for open
- open file
- end
- end
-
- // open binary prompt
- function askopenb
- askx "File to open in Binary Mode" "_load" "open" 'b'
- end
-
- // macro expression prompt
- function askeval
- if askx "Macro Expression" "_cmd" "eval" then
- error = geterror 'c'
- if error then
- msgbox "Expression column " + (geterror 'k') +
- ": " + (errormsg error) "Error" 'b'
- end
- end
- end
-
- // prompt to include a macro
- function askimacro
- askx "Include Macro File" "_load" "includemacro2"
- end
-
- // prompt to run a macro
- function askrmacro
- askx "Run Macro File" "_load" "runmacro2"
- end
-
- // prompt to compile a macro
- function askcmacro
- askx "Compile Macro File" "_load" "compilemacro2"
- end
-
- // macro picklist
- function pickmacro
- macro = askfile getbootpath + "MACRO\\*.X" "Select a macro to run"
- _FmgrSort _FmgrOpt "maclist"
- if macro then
- runmacro macro
- end
- end
-
- // DOS command prompt
- function askrun
- askx "DOS Command" "_os" "run" "ck"
- end
-
- // prompt to capture DOS output
- function askruncap
- askx "Capture DOS Output" "_os" "runcap" 'c'
- end
-
- // open key macro file with messages
- function openkey2 (file)
- if openkey file then
- say (getname file) + " loaded"
- else
- say "Load failed" 'b'
- end
- end
-
- // prompt to open a key macro file
- function askopenkey
- file = ask "Key macro filename" "_load"
- if file then
- openkey2 (qualify (defext file "mac") (getbufname))
- end
- end
-
- // prompt to save current key macros
- function asksavekey
- file = ask "Save current key macros as" "_load"
- if file then
- file = qualify (defext file "mac") (getbufname)
- if pos (askrac file "ok") "or" 'i' then
- if not savekey file then
- say "Save failed" 'b'
- end
- end
- end
- end
-
- // search files for a string in multi-string format with msgs
- function searchfiles (s)
- var searchstr
- var filespec
- var options
- n = splitstr '' s ref searchstr ref filespec ref options
- if n < 3 then
- options = _SearchOpt
- if n < 2 then
- filespec = '.'
- end
- end
- if searchstr then
- r = scanfiles filespec searchstr options
- if r <= 0 then
- say (if? r filespec s) + " not found" 'b'
- else
- addhistory "_find" (joinstr '' searchstr options)
- end
- end
- end
-
- // prompt to scan files for a string
- function askscan
- scanstring = if _PromptStyle == 'd' then
- scandlg
- else
- ask "[string/files/iwx] Scan" "_scan"
- end
- if scanstring then
- searchfiles scanstring
- addhistory "_scan" scanstring
- end
- end
-
- // reload the current file from disk
- function reopen (file)
- open (if? file file getbufname) 'r'
- end
-
- // open last file or directory
- function openlast
- file = gethiststr "_load"
- if file then
- open file
- end
- end
-
- // open an AML configuration file in boot directory
- function opencfg (file)
- open (bootpath file + ".aml")
- end
-
- // quick reference help
- function quickref (options openopt)
- quickfile = getbootpath + (if? options <> 'o' "DOC\\") +
- case options [1]
- when 'l' "LANGUAGE.DOX"
- when 'f' "FUNCTION.DOX"
- when 'q' "QUICKFUN.DOX"
- when 'o' "ORDERFRM.DOC"
- when 't' "TIPS.DOX"
- otherwise "USER.DOX"
- end
- if (wintype? "edit") and (pos 'w' options) then
- wordstr = send "getword" "a-zA-Z0-9?"
- end
- open quickfile openopt
- if wordstr then
- gotopos 1 1
- // find string in reference
- if find (char 0ffh) + wordstr + (char 0ffh) then
- right
- send "onfound" (sizeof wordstr)
- // not found? then try function header in EXT.AML
- elseif poschar 'fq' options then
- close
- ext = bootpath "EXT.AML"
- closeit = _MultCopy == 'n' and not (findbuf ext)
- open ext openopt
- gotopos 1 1
- n = find "function #" + wordstr 'x'
- if n then
- send "onfound" n
- else
- // still not found? then go back to the reference
- if closeit then
- close
- end
- open quickfile openopt
- end
- end
- end
- end
-
- // popup menu to change the default prompt style
- function askprompt
- menu "prompts"
- item " &Command line" 1
- item " &One-line box" 2
- item " &Two-line box" 3
- item " &Dialog box" 4
- end
- newtype = popup (getcurrbuf) "Select a Prompt Style" 25
- if newtype then
- setobj _PromptStyle "c12d" [newtype] "prf"
- end
- destroybuf "prompts"
- end
-
-
- // ───────────────────────────────────────────────────────────────────
- // Prompts and Edit windows
- // ───────────────────────────────────────────────────────────────────
-
- object prompt
-
- // support for cua-style <shift> key marking
- function smark
- if shiftkey? then
- if _shfx then
- undobegin
- destroymark
- markstream _shfx _shfx _shfy _shfy
- _shfx = ''
- _shfy = ''
- end
- extendmark
- end
- end
-
- // set anchor for shift-key marking
- function shiftdown
- _shfx = getcol
- _shfy = getrow
- pass
- end
-
- // end shift-key mark
- function shiftup
- stopmark
- pass
- undoend
- end
-
- // backspace in a prompt
- function backsp
- if getcol > 1 then
- left
- delchar
- end
- end
-
- // get the word at the cursor
- function getword (charset column mark)
- if not column then
- column = getcol
- end
- if column <= getlinelen then
- if not charset then
- charset = _CSet
- end
- b = posnot charset (gettext column)
- if b <> 1 then
- b = if? b column + b - 2 getlinelen
- a = posnot charset (gettext 1 column) 'r'
- a = if? a a + 1 1
- if mark then
- undobegin
- destroymark
- markchar a b
- undoend
- else
- gettext a b - a + 1
- end
- end
- end
- end
-
- // mark the word at the cursor using getword
- function markword (charset)
- getword charset '' 1
- end
-
- // mark to end-of-line
- function markeol
- undobegin
- destroymark
- if getcol <= getlinelen then
- markchar (getcol) (getlinelen)
- end
- undoend
- end
-
- // delete a block
- function deleteblock2
- if getmarkbuf == getcurrbuf then
- deleteblock
- else
- if wintype? "edit" then
- if _DelLine == 'y' then
- delline
- end
- end
- end
- end
-
- // prompt to enter character literally
- function literal
- say "Enter Literal..."
- queue <char> (char getkey & 0ffh)
- end
-
- // ascii chart with character entry
- function asciilist
- buffer = asciibuf
- // name it so the position can be remembered
- setbufname "_asc"
- character = (popup buffer '' 13) [10]
- destroybuf
- if character then
- queue <char> character
- end
- end
-
- // support for file name completion (open prompts only)
- function askcomplete
- if gethistname == "_load" then
- filespec = gettext
- if filespec then
- if not pos "*.*" filespec then
- filespec = filespec + (if? (pos '.' filespec) '*' "*.*")
- end
- else
- filespec = "*.*"
- end
- file = picklist (qualify filespec (getbufname (getwinbuf (getprevwin))))
- if file then
- col 1
- delchar (getlinelen)
- writetext file
- return file
- end
- end
- end
-
- // get the first line of text in the default mark
- function getmarktext
- if mark? then
- buffer = getmarkbuf
- topline = getmarktop
- if getmarktype == 'l' then
- gettext (getlinebeg topline buffer) (getlinelen topline buffer)
- (getmarktop) buffer
- else
- gettext (getmarkleft) (getmarkcols) topline buffer
- end
- end
- end
-
- // copy or copy-append to the clipboard
- function copy (options)
-
- if mark? then
- currentbuf = getcurrbuf
-
- clip = _ClipName
- destroymark clip
- copymark (getmarkuse) clip
-
- // copy
- if options and (buffer? clip) then
- if getmarktype <> 'l' then
- insline '' '' (getlines clip) clip
- end
- copyblock clip clip 1 (getlines clip)
- markline 1 (getlines clip) clip clip
-
- // copy append
- else
- destroybuf clip
- createbuf clip
- copyblock clip clip
- if getmarktype == 'l' then
- delline 1 1 clip
- end
- end
- currbuf currentbuf
- end
- end
-
- // cut or cut-append to the clipboard
- function cut (options)
- if mark? then
- copy options
- deleteblock
- end
- end
-
- // enter a character or string into the current prompt
- function write (charstring)
- writetext charstring
- end
-
-
- // ───────────────────────────────────────────────────────────────────
- // Edit windows
- // ───────────────────────────────────────────────────────────────────
-
- object edit
-
- // mark a paragraph
- function markpara
-
- if getlinelen then
-
- undobegin
- destroymark
-
- // find the beginning of the paragraph
- pushcursor
- while up and getlinelen end
- if not getlinelen then
- down
- end
- markline
- popcursor
-
- // find the end of the paragraph
- pushcursor
- while down and getlinelen end
- if not getlinelen then
- up
- end
- markline
- popcursor
-
- undoend
-
- return 1
- end
- end
-
- // setup for insert-above (copy, move, paste - lineblocks only)
- function begabove
- _ba = ''
- undobegin
- if _InsAbove == 'y' and getmarktype == 'l' then
- _ba = 1
- if not up then
- insabove
- up
- _ba = 2
- end
- end
- end
-
- // end insert-above
- function endabove
- case _ba
- when 1 down
- when 2 delline
- end
- undoend
- end
-
- // paste or paste-over from the clipboard
- function paste (options)
- if mark? _ClipName then
- destroymark
- copymark _ClipName (getmarkuse)
- if options then
- copyblockover
- else
- begabove
- copyblock
- endabove
- end
- else
- say "Nothing to paste" 'b'
- end
- end
-
- // clear the clipboard
- function clear
- destroybuf _ClipName
- end
-
- // copy a block
- function copyblock2
- if mark? then
- begabove
- if not copyblock then
- say "Copy failed" 'b'
- end
- endabove
- else
- if _CopyLine == 'y' then
- undobegin
- markline
- copyblock
- destroymark
- undoend
- end
- end
- end
-
- // move a block
- function moveblock2
- begabove
- if getmarktop < getviewtop then
- y = 1 + getrow - (apparentrow getviewtop - getrow)
- end
- if moveblock then
- if y then
- adjustrow y
- end
- else
- say "Move failed" 'b'
- end
- endabove
- end
-
- // move a block over text
- function moveblockover
- if mark? then
- undobegin
- copy
- fillblock ' '
- paste 'o'
- undoend
- end
- end
-
- // reformat a block or the current paragraph
- function formatblock2 (options)
- undobegin
- if not mark? then
- if markpara "tb" then
- markcolumn (getcol) _RMargin (getmarktop) (getmarkbot)
- flag = ON
- end
- end
- // special case for single lines
- if getmarkrows == 1 and getcol < getlinebeg then
- delchar getlinebeg - getcol
- else
- formatblock _LMargin _RMargin options
- end
- if flag then
- destroymark
- end
- undoend
- end
-
- // simple text quoting support for a block or the current paragraph
- function quote
- undobegin
- if not mark? then
- tempmark = TRUE
- markpara
- end
- if mark? then
- shiftblock 1 '' '>'
- if tempmark then
- destroymark
- end
- else
- say "Nothing to quote"
- end
- undoend
- end
-
- // sort a block
- function sortblock2
- sortblock
- // scrollock ON=descending // insert ON=ignore case
- (if? (shiftkey? 10h) 'd') + (if? (insert?) 'i')
-
- end
-
- // prompt to fill a block with a string
- function fillblock2
- askx "Enter fill string" '' "fillblock"
- end
-
- // prompt to save a block
- function saveblock2 (options)
- var c1
- var c2
- if mark? then
- file = ask "Save block as" "_load"
- if file then
- file = qualify file (getbufname)
- addhistory "_load" file
- if fileattr? file 'r' then
- say "Read Only!" 'b'
- else
- action = locase (askrac file)
- if pos action "ra" then
- send "oncomment" file ref c1 ref c2
- options = _SaveOpt + options
- if not saveblock file
- (if? (pos 'e' options) 'e' + _TabWidth) + options +
- (if? action == 'a' 'a') ''
- '' '' (if? c1 c1 + _FoldSign) c2 then
- msgbox "Save Failed!" "Error!" 'b'
- end
- end
- end
- end
- else
- say "No marked block" 'b'
- end
- end
-
- // left justify, center, or right justify a block
- function justblock2 (options)
- justblock options '' _LMargin _RMargin
- end
-
- // destroy open and closed folds
- function destroyfold2
- undobegin
- if not fold? then
- closefold
- end
- destroyfold
- undoend
- end
-
- // do fold operations on entire file
- function foldall (options)
- undobegin
- usemark 'T'
- markline 1 (getlines)
- foldblock options
- destroymark
- usemark
- undoend
- end
-
- // fold a block or the current paragraph
- function foldblock2
- undobegin
- if mark? then
- foldblock
- elseif markpara then
- foldblock
- destroymark
- end
- undoend
- end
-
- // fold a block and destroy subfolds
- function foldflat
- undobegin
- foldblock 'ds'
- foldblock
- undoend
- end
-
- // fold or unfold a line
- function foldline (options)
- undobegin
- usemark 'T'
- markline
- unfold = pos 'u' options
- if fold? then
- foldblock 'd'
- if not unfold or getmarkrows > 1 then
- bottom = actualrow (if? unfold -1 1) (getmarkbot)
- if not (getfold 'o' bottom) then
- markline (getrow) bottom
- end
- foldblock
- end
- else
- if not unfold then
- foldblock
- end
- end
- destroymark
- usemark
- undoend
- end
-
- // detab or entab the current file
- // (+width=detab, -width=entab)
- function tabfile (width)
- undobegin
- usemark 'T'
- markline 1 (getlines)
- tabblock (if? width width _TabWidth)
- destroymark
- usemark
- undoend
- end
-
- // insert a line after the current line with autoindent
- function insline2
- undobegin
- insline
- if setting? 'A' then
- if getlinelen then
- col (getlinebeg)
- else
- nextline = getrow + 2
- if getlinelen nextline then
- col (getlinebeg nextline)
- end
- end
- end
- down
- undoend
- end
-
- // swap the current line with the next line
- function swapline
- undobegin
- usemark 'T'
- markline
- stopmark
- down
- moveblock
- destroymark
- usemark
- undoend
- end
-
- // center the current line
- function centerline
- undobegin
- usemark 'T'
- markline
- justblock 'c' '' _LMargin _RMargin
- destroymark
- usemark
- undoend
- end
-
- // comment or uncomment a line
- function commentline (c1 c2)
- if not c1 then
- send "oncomment" (getbufname) ref c1 ref c2
- if not c1 then
- c1 = '>'
- end
- end
- undobegin
- column = getlinebeg
- if (gettext column (sizeof c1)) == c1 then
- delchar (sizeof c2) getlinelen - (sizeof c2) + 1
- delchar (sizeof c1) column
- elseif getlinelen then
- instext c1 (getlinebeg)
- if column then
- ovltext c2 getlinelen + 1
- end
- end
- down
- undoend
- end
-
- // find the previous word
- function prevword
- while getcol > 1 and (poschar _CSet (getchar)) do
- left
- end
- find _CSet "[r"
- while getcol > 1 and (poschar _CSet (getchar getcol - 1)) do
- left
- end
- end
-
- // find the next word
- function nextword
- while poschar _CSet (getchar) do
- right
- end
- find _CSet '['
- end
-
- // change the case of the word at the cursor
- function caseword (options charset)
- undobegin
- usemark 'T'
- markword charset
- caseblock options
- destroymark
- usemark
- undoend
- end
-
- // open the filename at the cursor
- function openword (charset)
- file = getword (if? charset charset _CSetB)
- if file then
- open file
- end
- end
-
- // delete the character at the cursor
- function delchar2
- undobegin
- if getcol > getlinelen and _DelJoin == 'y' then
- joinline
- else
- delchar
- if setting? 'L' then
- livewrap
- end
- end
- undoend
- end
-
- // backspace
- function backsp
- undobegin
- if getcol > 1 then
- left
- if not insert? and _BakOvl == 'y' then
- ovltext ' '
- else
- delchar
- if setting? 'L' then
- livewrap
- end
- end
- elseif getrow > 1 and _BakJoin == 'y' then
- up
- col getlinelen + 1
- joinline
- end
- undoend
- end
-
- // delete right word
- function delword (charset)
- if not charset then
- charset = _CSet
- end
- undobegin
- if getcol > getlinelen then
- joinline
- else
- p = posnot charset (gettext (getcol))
- if p > 1 then
- delchar p - 1
- end
- delchar (
- if p then
- if getchar == ' ' and
- (getcol == 1 or
- (posnot charset (getchar getcol - 1))) then
- (posnot ' ' (gettext (getcol))) - 1
- else
- p == 1
- end
- else
- getlinelen
- end
- )
- end
- if setting? 'L' then
- livewrap
- end
- undoend
- end
-
- // splitline with autoindent
- function splitline2 (column)
- undobegin
- b = getlinebeg
- if splitline column then
- if not setting? 'A' then
- b = _LMargin
- end
- if b > 1 then
- pushcursor
- down
- usemark 'T'
- markline
- shiftblock (if? getcol > b b (getcol)) - 1
- destroymark
- usemark
- popcursor
- end
- end
- undoend
- end
-
- // <enter> key behavior
- function enter
-
- // terminate a word for text translation
- lastrow = getrow
- if getcol == getlinelen + 1 and getlinelen then
- if setting? 'T' then
- send <char> ' '
- end
- end
-
- if getrow == lastrow then
- case (if? (insert?) _EnterIns _EnterOvl)
- when 'i'
- insline2
- when 's'
- if fold? then
- insline2
- else
- startcolumn = getlinebeg
- length = getlinelen
- splitline2
- down
- if setting? 'A' then
- if length then
- col startcolumn
- end
- else
- startcolumn = _LMargin
- col (if? startcolumn startcolumn 1)
- end
- end
- otherwise
- down
- col (if? (getlinelen) (getlinebeg) _LMargin)
- end
- end
- end
-
- // for use by variable tab right
- function vtabr
- i = 1
- while i <= arg do
- if (arg i) <= getcol then
- i = i + 1
- else
- return arg i
- end
- end
- return 0
- end
-
- // for use by variable tab left
- function vtabl
- i = arg
- while i do
- if (arg i) >= getcol then
- i = i - 1
- else
- return arg i
- end
- end
- return 0
- end
-
- // tab support
- function tabfunc (next)
-
- oldcolumn = getcol
-
- // smart tabs
- if setting? 'S' then
- prevline = getrow - 1
- while prevline and not (getlinelen prevline) do
- prevline = prevline - 1
- end
- if prevline then
- pushcursor
- row prevline
- send (if? next "nextword" "prevword")
- if prevline == getrow then
- newcolumn = getcol
- end
- popcursor
- end
- end
-
- // variable tabs
- if not newcolumn then
- if setting? 'V' then
- newcolumn = eval (if? next "vtabr " "vtabl ") + _VarTabs
- end
-
- // standard interval tabs
- if not newcolumn then
- width = _TabWidth
- if not width then
- width = 8
- end
- newcolumn = oldcolumn +
- if next then
- width - (oldcolumn - 1) mod width
- elseif oldcolumn > 1 then
- -((oldcolumn - 2) mod width + 1)
- end
- end
- end
-
- // move to tabstop and shift text if needed
- if newcolumn then
- if _TabShift == 'y' and insert? then
- if newcolumn < oldcolumn then
- delchar oldcolumn - newcolumn newcolumn
- elseif newcolumn > oldcolumn then
- instext (copystr ' ' newcolumn - oldcolumn)
- end
- end
- col newcolumn
- end
- end
-
- // tab left and right
- function tabright tabfunc 1 end
- function tableft tabfunc end
-
- // prompt to verify close
- function close?
- if bufchanged? and not getprevcurs then
- savechanges = popup "ync" "Save changes to " +
- (getname (getbufname)) + '?'
- if savechanges == "Yes" then
- save
- end
- icompare savechanges "Yes" "No"
- else
- 1
- end
- end
-
- // close an edit window
- function close (options)
- if pos 's' options then
- if save then
- pass
- end
- elseif close? then
- pass
- end
- end
-
- // open and insert prompt
- function askinsert
- file = ask "File to insert into " + (getname (getbufname)) "_load"
- if file then
- // addhistory not needed for open
- old_size = getlines
- undobegin
- open file 'i'
- // mark the inserted text
- if getlines > old_size then
- markline getrow + 1 getrow + getlines - old_size
- end
- undoend
- end
- end
-
- // prompt to change the current file name
- function askname
- newname = ask "Rename " + (getname (getbufname)) + " to" "_load"
- if newname then
- case setname newname
- when -1 say "Failed" 'b'
- when -2 say "Failed - file already loaded" 'b'
- otherwise
- addhistory "_load" (getbufname)
- end
- end
- end
-
- // search and replace with messages and highlighting
- function search2 (search_str reverse again)
- var opt
- var rpl
- n = search search_str reverse again ref opt ref rpl
- if n then
- // replace occurred
- if rpl then
- display
- say (thousands n) + " changes made"
- // count occurrences
- elseif pos 'a' opt then
- display
- say (thousands n) + " occurrences of '" + search_str + "' found"
- // search only
- else
- onfound n
- end
- else
- display
- say "'" + search_str + "' not found" 'b'
- end
- return n
- end
-
- // find prompt
- function askfind (reverse)
- search_string = if _PromptStyle == 'd' then
- finddlg
- else
- ask "[string/abgirswx] Find" "_find"
- end
- if search_string then
- search2 search_string reverse
- addhistory "_find" search_string
- end
- end
-
- // replace prompt
- function askrepl (reverse)
- search_string = if _PromptStyle == 'd' then
- repldlg
- else
- ask "[string/replstr/abgirswx] Repl" "_find"
- end
- if search_string then
- search2 search_string reverse
- addhistory "_find" search_string
- end
- end
-
- // do the last find/replace operation
- // (reverse=r reverses the search direction)
- function findlast (reverse)
- search2 (gethiststr "_find") reverse TRUE
- end
-
- // incremental search
- function isearch
-
- var search_string
-
- repeat
-
- settitle "I-search for [" + search_string + "] "
- keycode = getkey
- options = _SearchOpt
- new_char = ''
-
- case keycode
-
- when <backspace>
- if search_string then
- popcursor
- search_string = if (sizeof search_string) > 1 then
- search_string [1 : (sizeof search_string) - 1]
- else
- ''
- end
- if not search_string then
- display
- end
- options = '*'
- end
-
- when <ctrl p>, <ctrl r>
- options = 'r'
-
- when <ctrl n>, <ctrl l>
- // do nothing
-
- when <ctrl g>, <ctrl b>
- options = 'g'
-
- otherwise
- keyname = getkeyname keycode
- if (sizeof keyname) == 3 then
- pushcursor
- new_char = keyname [2]
- options = '*'
- else
-
- // restore window title
- settitle (getbufname)
- display
-
- // clear all pushed cursors
- popcursor "ad"
- addhistory "_find" search_string
-
- if keycode <> <enter> and keycode <> <esc> then
- queuekey keycode
- end
-
- done = TRUE
- end
- end
-
- if not done and (search_string or new_char) then
- new_string = concat search_string new_char
- str_length = find new_string _SearchOpt + options
- if str_length then
- onfound str_length
- search_string = new_string
- else
- say new_string + " not found" 'b'
- if new_char then
- popcursor
- end
- onfound (sizeof search_string)
- end
- end
-
- until done
- end
-
-
- // find occurrences search
- function findo (string_and_opt)
-
- var search_string
- var options
- var o
-
- n = splitstr '' string_and_opt
- ref search_string ref options ref o
-
- // initialize search options
- if n >= 2 then
- if n > 2 then
- options = o
- end
- else
- options = _SearchOpt
- end
- if pos 'g' options then
- options = sub 'g' '' options
- end
- options = options + '*'
-
- // do the search
- buffer = createbuf
- ovltext "≡≡≡≡≡≡ Select this line to edit occurrences ≡≡≡≡≡≡"
- gotobuf (getprevbuf)
- pushcursor
- gotopos 1 1
- while find search_string options do
- addline getrow + ": " + gettext '' '' buffer
- col MAX_COL
- end
- popcursor
-
- // display occurrences
- if (getlines buffer) > 1 then
- bname = getbufname
- line = popup buffer
- "Occurrences of '" + search_string + "' in "
- + (getname bname) + " - " + ((getlines buffer) - 1) +
- " lines" getvidcols - 11 getvidrows - 8
- if line then
- if line [1] == '≡' then
- delline 1 1 buffer
- setbufname (qualify "TEMP.TXT" bname) buffer
- openbuf buffer
- else
- destroybuf buffer
- gotopos 1 line [1 : (pos ':' line) - 1]
- onfound (find search_string options + '*')
- end
- end
- else
- destroybuf buffer
- display
- say "'" + string_and_opt + "' not found" 'b'
- end
- end
-
- // prompt to find occurrences
- function askfindo
- search_str = ask "[string/birswx] Find occurrences of" "_find"
- if search_str then
- findo search_str
- addhistory "_find" search_str
- end
- end
-
- // find all occurrences of last find string
- function findlasto
- findo (gethiststr "_find")
- end
-
- // find matching character (){}[]<>
- function gotomatch2
- if gotomatch "(){}[]<>" then
- onfound 1
- else
- say "Not found" 'b'
- end
- end
-
- // goto column
- function col2 (column)
- case column [1]
- when '+' right column [2 : TO_END]
- when '-' left column [2 : TO_END]
- otherwise col (if? column > MAX_COL MAX_COL column)
- end
- onfound
- end
-
- // goto line
- function row2 (line)
- case line [1]
- when '+' down line [2 : TO_END]
- when '-' up line [2 : TO_END]
- otherwise row (if? line > getlines (getlines) line)
- end
- onfound
- end
-
- // goto line prompt
- function askrow
- askx "Line number" "_line" "row2"
- end
-
- // goto column prompt
- function askcol
- askx "Column Number" '' "col2"
- end
-
- // set a quick bookmark
- function quickbook
- _bk = _bk + 1
- bookmark = "Book" + _bk
- setbook bookmark
- display
- say "Bookmark " + bookmark + " set"
- end
-
- // place a bookmark
- function placebook (bookmark)
- if not bookmark then
- bookmark = ask "Bookmark Name" "_book"
- end
- if bookmark then
- setbook bookmark
- display
- say "Bookmark '" + bookmark + "' set"
- end
- end
-
-
- // Go to the compiler error on the current line of a compiler
- // error output file. This function recognizes compiler errors
- // of the form:
- //
- // <text> FILENAME.EXT <text> LINENUMBER <text> : MESSAGE
- //
- // (implemented by using regular expression searching confined
- // to the current line)
-
- function gotoerror
- pushcursor
- // filename charclass to use (max closure without the period)
- fileset = "[a-zA-Z0-9_\-/\\\\@~:^!#$%&`']#"
- file_ext = fileset + '\\.' + fileset
- // find the filename
- length = find file_ext 'xgl*'
- if length then
- filename = gettext (getcol) length
- right length
- // find the line number
- length = find "[0-9]#" 'xl'
- if length then
- line = gettext (getcol) length
- // find the message
- if find ':' 'l' then
- message = gettext getcol + 1
- popcursor
- // open the file
- if open filename then
- row line
- col (getlinebeg)
- send "onfound"
- say message + ' '
- return
- end
- end
- end
- end
- popcursor
- display
- say "Compiler message not recognized."
- end
-
-
- // backup a file and return the backup filename if sucessful
- function backup (file)
- if locatefile file then
- dir = _BackupDir
- if dir then
- if (sizeof dir) > 3 and dir [LAST_CHAR] == "\\" then
- dir = dir [1 : (sizeof dir) - 1]
- end
- createdir dir
- dir = qualify dir
- backup_file = if pos "*.*" dir then
- qualify (getname file) dir
- else
- msgbox "Unable to create backup file!"
- "Warning!"
- return 1
- end
- else
- backup_file = forceext file _BackupExt
- end
-
- // delete the old backup file
- deletefile backup_file
-
- // attempt a rename
- if not renamefile file backup_file then
- // try copy if rename fails
- if (copyfile file backup_file) <= 0 then
- msgbox "File backup failed!" "Error"
- return 0
- end
- end
- return backup_file
- else
- return 1
- end
- end
-
- // save the current file to disk
- function save (file options)
- var c1
- var c2
-
- // check for a truncated file
- if trunc? and
- not (icompare (popup "ok" "Truncated file - are you sure?") "Ok") then
- return
- end
-
- file = if file then
- qualify file (getbufname)
- else
- getbufname
- end
- if fileattr? file 'r' then
- say "Read Only!" 'b'
- else
- backup_file = 1
- if setting? 'B' then
- backup_file = backup file
- end
- if not backup_file then
- say "Backup failed" 'b'
- else
- send "onsave" file
-
- // get fold comments for the file (if any)
- send "oncomment" file ref c1 ref c2
- options = _SaveOpt + options
- if not savebuf file
- (if? (pos 'e' options) 'e' + _TabWidth) + options ''
- (if not getbinarylen then hex2bin _LineDlm end) ''
- (if? c1 c1 + _FoldSign) c2 then
-
- // restore the backup after save failure
- if backup_file <> 1 then
- if not renamefile backup_file file then
- copyfile backup_file file
- end
- end
- msgbox "Save failed! Check file path / file attributes / disk space" "Error!" 'b'
- return 0
- else
- 1
- end
- end
- end
- end
-
- // save-as prompt
- function asksaveas (options)
- file = ask "Save " + (getname (getbufname)) + " as" "_load"
- if file then
- file = qualify file (getbufname)
- addhistory "_load" file
- save file options
- end
- end
-
- // start, stop, or do autosave
- function autosave (seconds)
- if not seconds then
- if bufchanged? then
- save
- end
- elseif seconds < 0 then
- destroytimer "asav"
- else
- setrepeat "asav" seconds * 1000 '' "autosave"
- end
- end
-
- // prompt for autosave interval in seconds
- function askasave
- seconds = ask "Autosave interval in secs (-1=disable)"
- if seconds then
- autosave seconds
- end
- end
-
- // highlight all occurrences of the word at the cursor
- function hiliteword
- sobj = send "onsyntax" (getbufname)
- if not sobj then
- setting 'X' DEFAULT
- sobj = "syndef"
- end
- if sobj then
- w = send "getword" "a-zA-Z_0-9?"
- if w then
- // create a color selection menu
- menu "hcolor"
- item " &None" -1
- item " &Default" -2
- item "-"
- item " &Black" color white on black
- item " B&lue" color yellow on blue
- item " &Green" color white on green
- item " &Cyan" color white on cyan
- item " &Red" color white on red
- item " &Magenta" color white on magenta
- item " Br&own" color white on brown
- item " Gr&ay" color white on gray
- item "-"
- item " Dar&kgray" color white on darkgray
- item " Brightbl&ue" color white on brightblue
- item " Brightgr&een" color black on brightgreen
- item " Brig&htcyan" color black on brightcyan
- item " Br&ightred" color white on brightred
- item " Brightmagen&ta" color white on brightmagenta
- item " &Yellow" color black on yellow
- item " &White" color black on white
- end
- setbufname "colorlist"
- hcolor = popup "hcolor" "select a color "
- // destroy the menu
- destroybuf "hcolor"
- if hcolor then
- if hcolor == -1 then
- unsetx w sobj
- else
- setxobj w (if? hcolor == -2 '' hcolor) sobj
- end
- end
- display
- end
- end
- end
-
- // live word wrap support
- function livewrap
-
- if fold? then
- return
- end
-
- startcol = getlinebeg
- if getrow < getlines and (getlinelen getrow + 1) then
- n = getlinebeg getrow + 1
- startcol = if? n < startcol n startcol
- elseif not getlinelen or not (setting? 'A') then
- startcol = _LMargin
- end
-
- if getcol < startcol then
- startcol = getcol
- end
-
- if getlinelen then
- undobegin
- saved_char = getchar
- ovltext '■'
-
- // mark to the end of the paragraph
- pushcursor
- top = getrow
- while down and getlinelen do end
- if not getlinelen then
- up
- end
- bottom = getrow
- popcursor
-
- // reformat
- usemark 'T'
- markcolumn startcol _RMargin top bottom
- formatblock '' '' "kr"
- destroymark
- usemark
-
- // find the original cursor position
- col 1
- find '■' '*'
- ovltext (if? saved_char saved_char ' ')
-
- undoend
- end
- end
-
- // enter a character or string at the cursor, with support for:
- // - match character
- // - translate
- // - standard word wrap
- // - live word wrap
-
- function write (write_str)
-
- // group together as one undoable operation
- undobegin
-
- // enter the character or string at the cursor and
- // advance the cursor
- writetext write_str
-
- // get the current window settings
- setting_str = getsettings
-
- // match character
- if pos 'M' setting_str then
- instext ( case write_str
- when '"' '"'
- when '(' ')'
- when '[' ']'
- when '{' '}'
- otherwise ''
- end )
- end
-
- // translate
- if pos 'T' setting_str then
-
- // delimited lookup?
- to_word_end = if? (posnot _TranCSet write_str) 2 1
-
- // get the last word typed
- word_str = getword _TranCSet (getcol - to_word_end)
- if word_str then
- lookup_str = word_str + (if? to_word_end == 2 '*')
-
- // lookup the word in the translate object
- value = lookup lookup_str _TranObj
-
- if value then
- // is it a function? ..then evaluate it
- if function? lookup_str _TranObj then
- eval value
-
- // otherwise replace the word
- else
- word_column = getcol - (sizeof word_str) - to_word_end + 1
- delchar (sizeof word_str) word_column
- instext value word_column
- col word_column + (sizeof value) + to_word_end - 1
- end
- end
- end
- end
-
- // check for word wrap and live wrap
- if getlinelen > _RMargin then
-
- // live word wrap
- if pos 'L' setting_str then
- livewrap
-
- // standard word wrap
- elseif (pos 'W' setting_str) and (not fold?) then
- column = getcol
- limit = _RMargin + 1
- if column > limit then
- if write_str <> ' ' then
- first_col = if? (setting? 'A') (getlinebeg) _LMargin
- split_col = pos ' ' (gettext 1 limit) 'r'
- split_col = if? split_col > first_col split_col + 1 limit
- splitline split_col
- down
- markline '' '' 'T'
- shiftblock first_col - 1 'T'
- destroymark 'T'
- col column - split_col + first_col
- end
- end
- end
- end
-
- undoend
- end
-
- // enter a date/time stamp at the cursor
- function timestamp
- write getdate + ' ' + gettime
- end
-
-
- // ───────────────────────────────────────────────────────────────────
- // File Manager windows
- // ───────────────────────────────────────────────────────────────────
-
- object fmgr
-
- // return the file name for fmgr commands
- function fname2
- if fmark? then
- "MARKED FILES"
- else
- getname (getffile)
- end
- end
-
- // error notification
- function ferror (s)
- msgbox s + " Failed" "Error!" 'b'
- end
-
- // fmgr confirmation prompt
- function fconfirm (confirm pstring func)
- if (icompare confirm 'n') or
- (icompare (popup "ok" pstring + ' ' + fname2 + '?') "ok") then
- fdomark func
- reopen
- end
- end
-
- // internal fopen
- function fopn (file options)
- if file then
- openf file options
- else
- fdomark "fopn" options
- end
- end
-
- // fmgr open file(s) command
- function fopen (options)
-
- var searchopt
-
- if pos '1' options then
- if shiftkey? then
- options = options + 'v'
- end
- scanstr = fscanstr
- openf '' options
-
- // find first occurrence for scan windows
- if scanstr then
- addhistory "_find" scanstr
- splitstr '' scanstr '' ref searchopt
- gotopos 1 (if? (pos 'r' searchopt) (getlines) 1)
- send "onfound" (search scanstr)
- end
-
- else
- fopn '' options
- end
- end
-
- // fmgr change file attributes command
- function fattr (file attr)
- if file then
- chgfileattr file attr
- else
- attr = ask "New attributes [AHSR] for " + fname2
- if attr then
- fdomark "fattr" (if? attr <> ' ' attr)
- reopen
- end
- end
- end
-
- // fmgr delete file(s) command
- function fdelete (file)
- if file then
- if pos "*.*" file then
- file = getpath file
- end
- if not deletefile file 'd' then
- ferror "Delete"
- end
- else
- fconfirm _ConDel "Delete" "fdelete"
- end
- end
-
- // fmgr touch file(s) command
- function ftouch (file)
- if file then
- if not touchfile file then
- ferror "Touch"
- end
- else
- fconfirm _ConTch "Touch" "ftouch"
- end
- end
-
- // print a file or directory with the current printer settings
- function printfile (file)
- if loadbuf file '' '' _FmgrOpt _TruncLength then
- print
- destroybuf
- end
- end
-
- // fmgr print file(s) command
- function fprint (file)
- if file then
- if not printfile file then
- ferror "Print"
- end
- else
- fconfirm 'y' "Print" "fprint"
- end
- end
-
- // fmgr run file command
- function frun (options)
- run (getffile) options
- reopen
- end
-
- // fmgr rename file command
- function frename
- oldname = getffile
- newname = ask "Rename " + (getname oldname) + " to" "_load"
- if newname then
- if renamefile oldname (qualify newname (getbufname)) then
- reopen
- else
- ferror "Rename"
- end
- end
- end
-
- // fmgr copy (or move) file(s) command
- function fcopy (source dest options)
- if source then
- if dir? dest then
- dest = qualify (getname source) dest
- end
- action = askrac dest
- if pos action "ra" 'i' then
- move? = options == 'm'
- say (if? move? "Mov" "Copy") + "ing " + source "..."
- if not move? or (icompare action 'a') or not (renamefile source dest) then
- if not copyfile source dest (if? (icompare action 'a') 'a') then
- ferror (if? move? "Move" "Copy")
- fdobrk
- else
- if move? then
- deletefile source
- end
- end
- end
- end
- else
- if fmark? then
- dir_dest = qualify (getffile)
- if not dir? dir_dest then
- dir_dest = ''
- end
- end
- dest = ask (if? options == 'm' "Move " "Copy ") + fname2 + " to"
- "_load" dir_dest
- if dest then
- fdomark "fcopy" (qualify dest (getbufname)) options
- reopen
- end
- end
- end
-
- // fmgr move file(s) command
- function fmove
- fcopy '' '' 'm'
- end
-
- // fmgr create new directory command
- function fmkdir
- dir = ask "New directory name" "_load"
- if dir then
- if createdir (qualify dir (getbufname)) then
- reopen
- else
- ferror "Create directory"
- end
- end
- end
-
-
- // ───────────────────────────────────────────────────────────────────
- // On-Event functions called by the editor
- // ───────────────────────────────────────────────────────────────────
-
- // edit windows & file manager windows only
- object edit_fmgr
-
- // called while loading files
- function onloading (lines)
- say (if? lines "Loading [" + lines + "]..." getbufname)
- end
-
- // called while saving files
- function onsaving (lines)
- say (if? lines "Saving [" + lines + "]..." getbufname)
- end
-
- // called while printing files
- function onprinting (lines)
- say (if? lines "Printing [" + lines + "]... <ctrl break> to stop "
- getbufname)
- end
-
- // called while scanning files
- function onscanning (file found)
-
- // create scan progress window
- if not window? 'scan' then
-
- createwindow 'scan'
- setwinobj
- setframe ">b"
- setcolor border_color color white on gray
- setcolor text_color color black on gray
- settitle "Scanning" 'c'
- setborder "1i"
- setshadow 2 1
-
- // center the window
- width = (sizeof (getpath file)) + 24
- height = 16
- ox = (getvidcols - width) / 2
- oy = (getvidrows - height) / 2
- sizewindow ox oy ox + width oy + height "ad"
- writestr file + "..."
-
- elseif found then
- writestr " FOUND" (color brightgreen on gray) (getcoord 'x1') - 7
-
- elseif file then
- writeline
- writestr file + "..."
-
- else
- destroywindow
- end
-
- display
- end
-
- // called while compiling files
- function oncompiling (file lines)
- say (if? lines "Compiling " + file + " [" + lines + "]..." getbufname)
- end
-
-
- // edit windows only
- object edit
-
- // called after a file is opened and before it's displayed
- function onopen
-
- // set window event object
- setwinobj "edit"
-
- // default window settings (if not remembered by open)
- if not getsettings then
- setting _DefaultSet ON
- end
-
- // check for file truncation
- if trunc? then
- display
- say "File Truncated!" 'b'
- end
- end
-
- // called immediately before a file is saved
- //function onsave (file) then
- //end
-
- // called when switching to a file
- //function onfocus
- //end
-
- // called when closing a file
- //function onclose
- //end
-
- // called after a search to change the window view and
- // optionally highlight a string
- function onfound (stringlength)
-
- // check if the cursor is outside the window view
- if getcol < getviewleft then
- if getcol < getviewcols then
- rollcol -getviewleft
- else
- adjustcol 3
- end
- elseif getcol + stringlength >= getviewright then
- adjustcol
- end
-
- if getrow > getviewbot then
- adjustrow 3
- elseif getrow < getviewtop then
- adjustrow
- end
- display
-
- // highlight a string if stringlength is specified
- if stringlength then
- hilite stringlength 1 (getpalette (if? (inmark?) 9 8))
- end
- end
-
-
- object fmgr
-
- // called after a fmgr window is opened and before it's displayed
- function onopen
-
- // set the window event object
- setwinobj "fmgr"
-
- // check for include picklist
- if ftype? 'i' then
- display
- say "Select file to insert"
- end
- end
-
-
- // all windows
- object a
-
- // called when sounding an alarm
- // (allows you to customize the alarm sound)
- function onalarm
- beep 750 70
- end
-
- // get default comments for a filename (c1, c2 passed by reference)
- // (associates a filename with comment symbols)
- function oncomment (file c1 c2)
- case getext (upcase file)
- when ".C", ".AML", ".CPP", ".H" c1 = "//"
- when ".ASM" c1 = ';'
- when ".PAS" c1 = '{' c2 = '}'
- otherwise c1 = '>'
- end
- end
-
-
- // called when entering the editor before any windows are open.
- // DOS command-line filespecs are passed to this function
- function onentry
-
- // save the DOS entry path
- _cp = getcurrpath
-
- // open prompt and window history
- if _SaveHistory == 'y' then
- openhistory (bootpath "history.dat")
- end
-
- // process command-line parameters passed to the editor
- param_num = 1
- parameter = arg 1
-
- while parameter do
-
- // check for command line options
- if parameter [1:2] == "-e" then
- queue parameter [3 : TO_END]
-
- // open files/directories
- else
- open parameter
- end
-
- // next command line parm
- param_num = param_num + 1
- parameter = arg param_num
- end
-
- // still no windows open? then do bootoptions...
- if not getcurrwin then
- case _BootOpt
- when 'd' restoredesk
- when 'f' open '.'
- when 'n' opennew
- otherwise
- filespec = ask "File or Directory" "_load"
- if filespec then
- open filespec
- else
- halt
- end
- end
- end
-
- // initialize the mouse
- if _Mouse == 'y' then
- if openmouse _MouseOpt then
- mousepos 15999 + getvidcols 15999 + getvidrows
- y_sens = _MouSenY
- if (getos 'v') > 9 then
- mousesense (_MouSenX * 5) / 8 (y_sens * 5) / 8 _MouDST
- else
- mousesense _MouSenX y_sens _MouDST
- end
- end
- end
-
- // open key macros if configured
- if _SaveMac == 'y' then
- openkey (bootpath "a.mac")
- end
-
- // set autosave timer
- send "autosave" _AutoSave
- end
-
-
- // called when exiting the editor after all windows are closed
- function onexit
-
- // open prompt on non-global exit (if configured)
- if not __G then
- if _ExitOpen == 'y' then
- filespec = ask "File or Directory" "_load"
- if filespec then
- open filespec
- end
- end
- end
-
- // final exit if no windows open
- if not getcurrwin then
-
- // save prompt and window history
- if _SaveHistory == 'y' then
- savehistory (bootpath "history.dat")
- end
-
- // save key macros if configured
- if _SaveMac == 'y' then
- // check if record occurred
- if lookup "kd" "mon" then
- savekey (bootpath "a.mac")
- end
- end
-
- // restore entry path saved in onentry
- currpath _cp
-
- closemouse
- halt
- end
- end
-
-